home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / lgraph / lgraph.p < prev    next >
Text File  |  1993-01-11  |  18KB  |  458 lines
  1. (**************************************************************************)
  2. (* This program simulates a graph environment for LaTeX. Using a list of  *)
  3. (* parameters, it generates LaTeX commands to produce a complete graph.   *)
  4. (* see the latexgraph.doc file for detailed documentation.                *)
  5. (* author:Sunil Podar, podar@sbcs.csnet, ...!{allegra,philabs}!sbcs!podar *)
  6. (* Please quote the following date when sending bug reports.          *)
  7. (* last update: Feb 2, 1987 (fixed bugs: wasn't doings things right when  *)
  8. (*        (0,0) was not on the graph. Also removed the printing of  *)
  9. (*        a few of the margin commands from preamble.          *)
  10. (* last update: Oct 5, 1986                          *)
  11. (**************************************************************************)
  12. program main (input,output);
  13. const   delim = '@';  (* Latex never uses @ except for \@ for a little *)
  14.               (* space before a sentence-ending period         *)
  15.     maxchar = 'F';(* maximum types of characters permitted for plotchar*)
  16.               (* A..F i.e. 6 distinct chars permitted *)
  17. type    wholeline  =  packed array[1..80] of char;
  18.         tenchar    =  packed array[1..10] of char;
  19.         ninechar   =  packed array[1..9] of char;
  20.     twochar    =  packed array[1..2] of char;
  21.     plotstufftype =    record
  22.               chardef : wholeline;
  23.               charname : wholeline
  24.             end;
  25. var
  26.     plotstuff : array['A'..maxchar] of plotstufftype;
  27.     error1,itsreal :boolean;
  28.     picwd,picht,pos,Xdeltabar,
  29.        Ydeltabar,i,Xlegloc,Ylegloc,Xdeltanum,Ydeltanum : integer;
  30.     Xaxisstrg,Yaxisstrg,capstring,blank80,labelname,fontname : wholeline;
  31.       legendloc,captiontwo,prepost : twochar;
  32.     string,blank10,captiontype,fignumber : tenchar;
  33.     plotchar,c : char;
  34.     string9 : ninechar;
  35.     Xscalegraph,Yscalegraph : integer;
  36.     XGorig,YGorig,XP1orig,YP1orig,XP2orig,YP2orig : integer;
  37.     Xscalereal,Yscalereal,xreality, yreality, xgraph, ygraph,
  38.     unitlngth,textwd,Xorignum,Yorignum,deln,num : real;
  39.  
  40. procedure strreadline(var commandstr: wholeline);
  41. var charac:char;
  42.     i : integer;
  43.     endoffile, endofline:boolean;
  44. begin
  45.    i:=1;
  46.    endoffile :=false;
  47.    endofline:=false;
  48.    commandstr:=blank80;
  49.    repeat
  50.       read(charac);
  51.       if (i < 80) then commandstr[i] := charac; (* 80th char remains @ *)
  52.       i := i+1;
  53.       if eof then endoffile :=true
  54.          else if eoln then endofline :=true
  55.    until (endoffile or endofline);
  56.    if (i <= 80) then commandstr[i] := delim;
  57.    if not endoffile then readln
  58. end; (*strreadline*)
  59.  
  60. procedure strreadword(var string: tenchar; var string9: ninechar);
  61. var charac:char;
  62.     i : integer;
  63. begin
  64.    i:=1;
  65.    string:=blank10;
  66.    read(charac);
  67.    repeat
  68.       string[i] := charac;
  69.       read(charac);
  70.       i := i+1
  71.    until ((charac = '/') or (charac = ' ') or (i > 10) or eoln);
  72.       (* so I'm reading the / without assigning it to string, neat *)
  73.    if (eoln and (i <=10)) then string[i]:= charac;
  74.       (* a kluge, to capture the last charac when using this procedure to *)
  75.       (* read the argument. normally I use it only for parameters. *)
  76.    for i:= 1 to 9 do string9[i] := string[i]
  77. end; (*strreadword*)
  78.  
  79. procedure strwrite(str: wholeline);
  80. var i : integer;
  81. begin
  82. i := 1;
  83. while (str[i] <> delim) do
  84.    begin
  85.      write(str[i]); i := i+1
  86.    end
  87. end;
  88.  
  89. procedure legendread;
  90. var i : integer;
  91.     temp : twochar;
  92. begin
  93.    temp := '  ';
  94.    legendloc := '  '; i := 0;
  95.    if (not eoln) then
  96.       repeat
  97.           i := i+1; read(legendloc[i]);
  98.       until  (eoln) or (i >= 2) or (legendloc[i] = '/');
  99.    if (not eoln) then if (legendloc[i] <> '/') then read(temp[1]);
  100.    if (temp[1] = '/') or (legendloc[i] = '/')
  101.       then readln(Xlegloc,Ylegloc)
  102.       else readln
  103. end; (* legendread *)
  104.  
  105. (* in the following procedures, the boolean var XorY: true => X & false => Y*)
  106. procedure putbars(XorY:boolean; Xpos, Ypos, deltabar, distance: integer);
  107. var times: integer;
  108. begin
  109.    times := distance div abs(deltabar);
  110.    if times > 0 then
  111.      if XorY (* X *)
  112.        then writeln('\multiput(',Xpos:1,',',Ypos:1,')(',
  113.         deltabar:1,',0){',times:1,'}{\line(0,1){2}}')
  114.        else writeln('\multiput(',Xpos:1,',',Ypos:1,')(0,',
  115.         deltabar:1,'){',times:1,'}{\line(1,0){2}}');
  116. end; (* putbars *)
  117.  
  118. (* see a note about putnumbers in the main program.         *)
  119. (* because we may have real numbers, we can't use a counter     *)
  120. (* in conjunction with a \multiput statement.            *)
  121. procedure putnumbers(XorY:boolean; fixedpos, initpos:integer;
  122.      initnum, deln:real; deltanum:integer; limit:real);
  123. var pos: integer;
  124.     num: real;
  125. begin
  126.    num:=initnum; pos:= initpos;
  127.    if (abs(num) - round(abs(num) - 0.5)) > 0 then itsreal := true;
  128.    while abs(pos) < abs(limit) do
  129.      begin
  130.         if XorY then (* X *)
  131.        write('\put(',pos:1,',',fixedpos:1,'){\makebox(0,0)[t]{')
  132.     else write('\put(',fixedpos:1,',',pos:1,'){\makebox(0,0)[r]{');
  133.     if itsreal then writeln(num:1:2,'}}')
  134.            else writeln(trunc(num):1,'}}');
  135.     pos := pos + deltanum;
  136.     num := num + deln
  137.      end;
  138. end; (* putnumbers *)
  139.  
  140. begin(* main *)
  141.    (*----------------------------------*)
  142.    (* Initializations & default values *)
  143.    (*----------------------------------*)
  144.    error1 := false;
  145.    itsreal:=false;
  146.    for i := 1 to 10 do blank10[i] := ' ';
  147.    for i := 1 to 79 do blank80[i] := ' '; blank80[80] := delim;
  148.    captiontype := blank10; captiontype := 'no        '; (*default 'no' *)
  149.    fignumber := blank10;
  150.    fontname  := blank80; (* just playing it safe *)
  151.    fontname  := '{normalsize}'; fontname[13] := delim;
  152.    labelname := blank80; labelname[1] := 'n';  (* default 'no' *)
  153.    prepost   := 'no';
  154.    unitlngth := 1.0;
  155.    picwd := 100; picht := 100; XP1orig := 0; YP1orig := 0;
  156.    legendloc := 'no';
  157.    Xscalegraph := 10; Xscalereal := 10;
  158.    Yscalegraph := 10; Yscalereal := 10;
  159.    Xdeltabar   := 5;  Xdeltanum  := 10;
  160.    Ydeltabar   := 5;  Ydeltanum  := 10;
  161.    Xorignum    := 0;
  162.    Yorignum    := 0;
  163.    for c := 'A' to maxchar do
  164.      begin
  165.     plotstuff[c].chardef[1] := 'n'; (* default value is 'no' *)
  166.     plotstuff[c].charname := blank80;
  167.     plotstuff[c].charname[1] := c;
  168.     plotstuff[c].charname[2] := delim
  169.      end;
  170.    Xlegloc := -999999;
  171.    Ylegloc := -999999;
  172.    strreadword(string, string9);
  173.    while string <> '%%%%%%%%%%' do
  174.    begin
  175.     if string =  '%pre&post?'  then readln(prepost[1])
  176.     else if string =  '%unitlngth'  then  readln(unitlngth)
  177.     else if string =  '%font-name'  then  strreadline(fontname)
  178.     else if string =  '%picdimens'  then  readln(picwd,picht,XP1orig,YP1orig)
  179.     else if string =  '%??caption'  then begin
  180.                           strreadword(captiontype, string9);
  181.                        readln
  182.                          end
  183.     else if string =  '%fignumber'  then begin
  184.                        strreadword(fignumber, string9);
  185.                        readln
  186.                       end
  187.     else if string =  '%Xaxisstrg'  then  strreadline(Xaxisstrg)
  188.     else if string =  '%Yaxisstrg'  then  strreadline(Yaxisstrg)
  189.     else if string =  '%capstring'  then  strreadline(capstring)
  190.     else if string =  '%labelname'  then  strreadline(labelname)
  191.     else if string =  '%legendloc'  then  legendread
  192.     else if string =  '%Xdeltab:n'  then  readln(Xdeltabar,Xdeltanum)
  193.     else if string =  '%Xoriginum'  then  readln(Xorignum)
  194.     else if string =  '%Ydeltab:n'  then  readln(Ydeltabar,Ydeltanum)
  195.     else if string =  '%Yoriginum'  then  readln(Yorignum)
  196.     else if string =  '%Xratiog:r'  then  readln(Xscalegraph,Xscalereal)
  197.     else if string =  '%Yratiog:r'  then  readln(Yscalegraph,Yscalereal)
  198.     else if string9 =  '%plotchar'  then
  199.         strreadline(plotstuff[string[10]].chardef)
  200.     else if string9 =  '%plotname'  then
  201.         strreadline(plotstuff[string[10]].charname)
  202.     else begin
  203.       readln;writeln;
  204.           writeln('**********************************************');
  205.           writeln('error: unknown string: "',string,'"');
  206.       writeln('**********************************************');
  207.       error1:=true
  208.      end;
  209.     string := blank10;
  210.     strreadword(string, string9)
  211.    end; (* while *)
  212.    readln;  (* this readln is to finish reading the %%%%%.. line*)
  213.  
  214.    (* THE FUN BEGINS HERE *)
  215.    if not error1 then
  216.    begin
  217.    textwd := picwd*unitlngth + 15.0; (* in mm *)
  218.    if (textwd < 170) then textwd := 170;
  219.    if textwd >240
  220.    then begin
  221.     writeln('% *****************************************************');
  222.         writeln('% max-possible-picwd is about 240mm which will have ');
  223.     writeln('% to be in Landscape. You''ll have to reduce scales.');
  224.     writeln('% *****************************************************')
  225.     end
  226.    else if textwd > 170 then
  227.         begin
  228.       writeln('% *****************************************************');
  229.       writeln('% THIS TEXT IS A BIT TOO WIDE FOR VERTICAL PAPER MODE.');
  230.       writeln('% YOU WILL HAVE TO USE LANDSCAPE MODE TO PRINT.');
  231.       writeln('% *****************************************************')
  232.     end;
  233.  
  234.    if prepost[1] = 'y' then
  235.    begin
  236.    writeln('\documentstyle{article}');
  237.    writeln('\setlength{\textwidth}{',textwd:1:2,'mm}');
  238.    writeln('\pagestyle{empty}     % => no page number ');
  239.    writeln('\begin{document}');
  240.    writeln;
  241.    end; (* end prepost *)
  242.  
  243.    write('\newcommand{\xaxis}{'); strwrite(Xaxisstrg);
  244.    writeln('} % the literal for X-axis');
  245.    write('\newcommand{\yaxis}{'); strwrite(Yaxisstrg);
  246.    writeln('} % the literal for Y-axis');
  247.    c := 'A';
  248.    while (plotstuff[c].chardef[1] <> 'n') and (c <= maxchar) do
  249.    begin
  250.        write('\newcommand{\pchar',c,'}');
  251.        strwrite(plotstuff[c].chardef); writeln;
  252.        c := chr(ord(c) + 1)
  253.    end;
  254.    writeln;
  255.    write('\begin'); strwrite(fontname); writeln; (* fontname contains braces*)
  256.    writeln('\begin{figure}[p]     %you might want different options here');
  257.  
  258.    (* XGorig & YGorig refer to the origin of the graph. *)
  259.    (* XP1orig & YP1orig refer to the bottom-left origin of the picture box.*)
  260.    (* XP2orig & YP2orig refer to the bottom-right corner of the picture box.*)
  261.    (* see if (0,0) is on the graph or not *)
  262.    XGorig := 0; YGorig := 0;
  263.    if XP1orig >= 0 then XGorig := XP1orig
  264.       else if (picwd + XP1orig) < 0 then XGorig := XP1orig + picwd;
  265.    if YP1orig >= 0 then YGorig := YP1orig
  266.       else if (picht + YP1orig) < 0 then YGorig := YP1orig + picht;
  267.    XP2orig := picwd + XP1orig;
  268.    YP2orig := picht + YP1orig;
  269.    writeln('\unitlength = ',unitlngth:1:2,'mm');
  270.    writeln('\begin{center}');
  271.    writeln('\begin{picture}(',(picwd+10):1,',',(picht+10):1,')(',
  272.             (XP1orig-5):1,',',(YP1orig-5):1,')');
  273.    (* need a box of +10 on both axes to account for -10 origins & to *)
  274.    (* get proper centering *)
  275.    writeln('\thicklines');
  276.    (* plot the horizontal axis *)
  277.    if (XP2orig - XGorig) > 0 then
  278.    begin
  279.      writeln('\put(',XGorig:1,',',YGorig:1,'){\vector(1,0){',
  280.                     abs(XP2orig-XGorig):1,'}}');
  281.      writeln('\put(',(XP2orig+2):1,',',YGorig:1,'){\makebox(0,0)[l]{X}}')
  282.    end;
  283.    if (XGorig - XP1orig) > 0 then
  284.    begin
  285.      writeln('\put(',XGorig:1,',',YGorig:1,'){\vector(-1,0){',
  286.         abs(XGorig-XP1orig):1,'}}');
  287.      writeln('\put(',(XP1orig-2):1,',',YGorig:1,
  288.         '){\makebox(0,0)[r]{X}}')
  289.    end;
  290.    (* plot the vertical axis *)
  291.    if (YP2orig - YGorig) > 0 then
  292.    begin
  293.      writeln('\put(',XGorig:1,',',YGorig:1,'){\vector(0,1){',
  294.                     abs(YP2orig-YGorig):1,'}}');
  295.      writeln('\put(',XGorig:1,',',(YP2orig+2):1,'){\makebox(0,0)[b]{Y}}')
  296.    end;
  297.    if (YGorig - YP1orig) > 0 then
  298.    begin
  299.      writeln('\put(',XGorig:1,',',YGorig:1,'){\vector(0,-1){',
  300.         abs(YGorig-YP1orig):1,'}}');
  301.      writeln('\put(',XGorig:1,',',(YP1orig-2):1,
  302.         '){\makebox(0,0)[t]{Y}}')
  303.    end;
  304.    writeln('\thinlines');
  305.  
  306.    (*********************************************************************)
  307.    (*the following put numbers & bars along X-axis and Y-axis        *)
  308.    (*********************************************************************)
  309.    putbars(true,XGorig,(YGorig-1),Xdeltabar,abs(XP2orig-XGorig));
  310.    putbars(true,XGorig,(YGorig-1),-Xdeltabar,abs(XGorig-XP1orig));
  311.    putbars(false,(XGorig-1),YGorig,Ydeltabar,abs(YP2orig-YGorig));
  312.    putbars(false,(XGorig-1),YGorig,-Ydeltabar,abs(YGorig-YP1orig));
  313.  
  314. (* Before invoking putnumbers, we must explicitly check if it needs to
  315.    be invoked at all. This is because in the procedure putnumbers I use
  316.    absolute values as the stopping condition for while loop.
  317.    We use absolute values in the procedure so as to handle plotting
  318.    numbers on both the positive and negative halves of the axes.
  319.    deln below represents the delta graph units corresponding to X|Ydeltanum.
  320. *)
  321.    writeln('% Add a line similar to next one if number at origin desired.');
  322.    deln  := (Xscalereal*Xdeltanum) / Xscalegraph;
  323.    pos := XGorig + Xdeltanum; num:=Xorignum + deln;
  324.    if pos < XP2orig then
  325.    putnumbers(true,(YGorig-2),pos,num,deln,Xdeltanum,XP2orig);
  326.    pos := XGorig - Xdeltanum; num:=Xorignum - deln;
  327.    if pos > XP1orig then
  328.    putnumbers(true,(YGorig-2),pos,num,-deln,-Xdeltanum,XP1orig);
  329.  
  330.    deln  := ( Yscalereal*Ydeltanum) / Yscalegraph;
  331.    pos := YGorig + Ydeltanum; num:=Yorignum + deln;
  332.    if pos < YP2orig then
  333.    putnumbers(false,(XGorig-2),pos,num,deln,Ydeltanum,YP2orig);
  334.    pos := YGorig - Ydeltanum; num:=Yorignum - deln;
  335.    if pos > YP1orig then
  336.    putnumbers(false,(XGorig-2),pos,num,-deln,-Ydeltanum,YP1orig);
  337.  
  338.    (***********************)
  339.    (* put the legend box  *)
  340.    (***********************)
  341.    if (legendloc <> 'no') then
  342.    begin   (* and if it is then obviously do nothing *)
  343.    if (Xlegloc = -999999) and (Ylegloc = -999999) then
  344.      begin   (* implies explicit coordinates not specified  *)
  345.              (* if they are then they are set in legendread *)
  346.     Xlegloc := picwd div 2; (* default is center *)
  347.     Ylegloc := picht div 2; (* default is center *)
  348.     if (legendloc[1] = 't') or (legendloc[2] = 't')
  349.       then if YP2orig > 0 then Ylegloc := picht else Ylegloc := picht-10;
  350.     if (legendloc[1] = 'b') or (legendloc[2] = 'b')
  351.       then if YP1orig >= 0 then Ylegloc := 10 else Ylegloc := 0;
  352.     if (legendloc[1] = 'l') or (legendloc[2] = 'l')
  353.       then if XP1orig >= 0 then Xlegloc := 10 else Xlegloc := 0;
  354.     if (legendloc[1] = 'r') or (legendloc[2] = 'r')
  355.       then if XP2orig > 0 then Xlegloc := picwd else Xlegloc := picwd-10;
  356.     Xlegloc := Xlegloc + XP1orig;
  357.     Ylegloc := Ylegloc + YP1orig
  358.      end;
  359.  
  360.    write('\put(',Xlegloc:1,',',Ylegloc:1,'){\makebox(0,0)');
  361.    i:= 1; write('[');
  362.    while (i <= 2) do
  363.        begin
  364.          if  (legendloc[i] <> ' ') and (legendloc[i] <> '/') then
  365.          write(legendloc[i]);
  366.          i:=i+1
  367.       end;
  368.    write(']');
  369.    writeln('{\fbox{\shortstack[l]{');
  370.    c:='A';
  371.    while (plotstuff[c].chardef[1] <> 'n') and (c <= maxchar) do
  372.    begin
  373.       write(' {\makebox(4,2)[lb]{\put(2,1){\pchar',c,'}}}: ');
  374.       strwrite(plotstuff[c].charname); writeln('\\');
  375.       c := chr(ord(c) + 1)
  376.    end;
  377.    writeln(' {\makebox(4,4)[b]{X}}: \xaxis \\');
  378.    writeln(' {\makebox(4,2)[b]{Y}}: \yaxis');
  379.    writeln(' }}}}')
  380.    end; (* not 'no' of legendloc*)
  381.  
  382.    (* put the caption if explicit *)
  383.    captiontwo[1]:=capstring[1];
  384.    captiontwo[2]:=capstring[2];
  385.    if captiontype[1] = 'e' then    (* "e"xplicit, anything else other than *)
  386.                    (* "L" for LaTeX => no   *)
  387.    if captiontwo = 'YX' then
  388.    begin
  389.      writeln('% if the caption line is longer than the graphwidth, comment');
  390.      writeln('% out the second line and use first one. you might have to');
  391.      writeln('% fiddle with the width of parbox in the second stmt.');
  392.      write('%\put(',XP1orig:1,',',(YP1orig-18):1,
  393.             '){\makebox(',picwd:1,',0)[tl]{');
  394.      writeln('Figure ',fignumber,'$\!$: \parbox[t]{',(textwd-32):1:1,'mm}{%');
  395.      write('\put(',XP1orig:1,',',(YP1orig-18):1,
  396.             '){\makebox(',picwd:1,',0)[t]{');
  397.      writeln('Figure ',fignumber,'$\!$: {%');
  398.      writeln('%\yaxis\ vs.\ \xaxis}}}')
  399.    end
  400.    else  (* means explicit string is specified *)
  401.    begin
  402.      write('%\put(',XP1orig:1,',',(YP1orig-18):1,
  403.             '){\makebox(',picwd:1,',0)[tl]{');
  404.      writeln('Figure ',fignumber,'$\!$: \parbox[t]{',(textwd-32):1:1,'mm}{%');
  405.      write('\put(',XP1orig:1,',',(YP1orig-18):1,
  406.             '){\makebox(',picwd:1,',0)[t]{');
  407.      writeln('Figure ',fignumber,'$\!$: {%');
  408.      strwrite(capstring); writeln;
  409.      writeln('}}}');
  410.    end;
  411.  
  412.    writeln('% beginning of data');
  413.    while not eof do
  414.    begin
  415.      readln(plotchar,xreality,yreality);
  416.      xgraph := (xreality*Xscalegraph)/Xscalereal;
  417.      ygraph := (yreality*Yscalegraph)/Yscalereal;
  418.      writeln('\put(',xgraph:1:5,',',ygraph:1:5,'){\pchar',plotchar,'}')
  419.    end;
  420.    writeln('% end of data');
  421.    writeln('\end{picture}');
  422.    writeln('\end{center}');
  423.  
  424.    (* put the LaTeX \caption if so specified *)
  425.    if captiontype[1] = 'L' then     (* "L"aTeX . if it is not = 'L' or 'e'*)
  426.                     (* then interpreted as 'no'  *)
  427.    begin
  428.      writeln('% if the caption line is longer than the graphwidth,use a');
  429.      writeln('% \parbox[t]{...mm}{.......} like statement for the argument');
  430.      writeln('% with suitable args for parbox to get things centered.');
  431.      if captiontwo = 'YX'
  432.     then begin
  433.          writeln('% You might want to add a [] to \caption below.');
  434.          writeln('\caption{\protect\normalsize \yaxis\ vs.\ \xaxis }')
  435.          end
  436.        else begin
  437.         writeln('\caption{\protect\normalsize ');
  438.         strwrite(capstring); writeln;
  439.         writeln('}')
  440.         end;
  441.      if labelname[1] = '{' then    (* anything else => 'no' *)
  442.     begin
  443.            write('\label'); strwrite(labelname); writeln
  444.                    (* labelname contains the braces *)
  445.         end
  446.    end;
  447.  
  448.    writeln('\end{figure}');
  449.    writeln;  (* a blank line is supposedly needed before \end fontname *)
  450.                  (* so says the latex manual *)
  451.    write('\end'); strwrite(fontname); writeln; (* fontname contains braces *)
  452.    writeln;
  453.  
  454.    if prepost[1] = 'y' then
  455.        writeln('\end{document}');
  456.    end (* not error1 *)
  457. end.
  458.